home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / dviware / dvitops / pspict.ps < prev    next >
Text File  |  1991-01-25  |  3KB  |  143 lines
  1. %!
  2. % $Header: /usr/jjc/dvitops/RCS/pspict.ps,v 1.2 89/02/20 14:22:58 jjc Rel $
  3.  
  4. /min { 2 copy gt {exch} if pop } bind def
  5. % x y roundpoint -- rx ry
  6. /roundpoint { transform round exch round exch itransform } bind def
  7.  
  8. % x y sign -- (y < 0 ? -x : x)
  9. /sign {    0 lt { neg } if } bind def
  10.  
  11. % x y len endpoint -- endx endy
  12. /endpoint { %def
  13.     /len exch def
  14.     /y exch def
  15.     /x exch def
  16.     x 0 eq { %ifelse
  17.         currentpoint len y sign sub
  18.     } { %else
  19.         currentpoint len x abs div y mul sub exch len x sign add exch
  20.     } ifelse
  21. } bind def
  22.  
  23. % linewidth diameter circle --
  24. /circle { %def
  25.     gsave
  26.     currentpoint newpath roundpoint 3 -1 roll 2 div 0 360 arc
  27.     setlinewidth
  28.     stroke
  29.     grestore
  30. } bind def
  31.  
  32. % diameter dot --
  33. /dot { %def
  34.     gsave
  35.     % a zero-length line is a convenient way to draw a solid circle
  36.     1 setlinecap
  37.     [] 0 setdash
  38.     setlinewidth
  39.     currentpoint roundpoint moveto 0 0 rlineto stroke
  40.     grestore
  41. } bind def
  42.  
  43. % linewidth dx dy len line --
  44. /line { %def
  45.     gsave
  46.     1 setlinecap
  47.     endpoint roundpoint
  48.     currentpoint roundpoint
  49.     moveto lineto
  50.     setlinewidth
  51.     stroke
  52.     grestore
  53. } bind def
  54.  
  55. % arrowlength arrowheight linewidth dx dy len vector --
  56. /vector { %def
  57.     4 copy line
  58.     3 copy endpoint moveto pop arrowhead
  59. } bind def
  60.  
  61. /char 1 string def
  62.  
  63. % linewidth width height ([tblr]*) oval --
  64. /oval { %def
  65.     gsave
  66.     1 setlinecap 1 setlinejoin
  67.     /t false def
  68.     /b false def
  69.     /l false def
  70.     /r false def
  71.     { char exch 0 exch put char cvn true def } forall
  72.     2 div /halfheight exch def
  73.     2 div /halfwidth exch def
  74.     halfheight halfwidth min /radius exch def
  75.     currentpoint roundpoint translate newpath
  76.     % we are assuming y coordinates increase down the page
  77.     % this code won't print a dashed [l] oval as well as it might
  78.     l t or not { %ifelse
  79.         % bottom right quadrant
  80.         halfwidth 0 moveto
  81.         halfwidth radius sub halfheight radius sub radius 0 90 arc
  82.         0 halfheight lineto
  83.     } { %else
  84.         0 halfheight moveto
  85.     } ifelse
  86.     r t or not { %ifelse
  87.         % bottom left quadrant
  88.         halfwidth neg radius add halfheight radius sub 
  89.         radius 90 180 arc
  90.         halfwidth neg 0 lineto
  91.     } { %else
  92.         halfwidth neg 0 moveto
  93.     } ifelse
  94.     r b or not { %ifelse
  95.         % top left quadrant
  96.         halfwidth neg radius add halfheight neg radius add
  97.         radius 180 270 arc
  98.         0 halfheight neg lineto
  99.     } { %else
  100.         0 halfheight neg moveto
  101.     } ifelse
  102.     l b or not { %if
  103.         % top right quadrant
  104.         halfwidth radius sub halfheight neg radius add 
  105.         radius 270 360 arc
  106.         halfwidth 0 lineto
  107.     } if
  108.     setlinewidth
  109.     stroke
  110.     grestore
  111. } bind def
  112.  
  113.  
  114. % length height linewidth dx dy arrowhead --
  115. /arrowhead { %def
  116.     gsave
  117.     1 setlinejoin 1 setlinecap
  118.     neg exch atan rotate
  119.     currentpoint roundpoint moveto
  120.     setlinewidth
  121.     2 div
  122.     1 index neg 1 index neg rmoveto
  123.     2 copy rlineto
  124.     exch neg exch rlineto
  125.     closepath
  126.     gsave [] 0 setdash stroke grestore
  127.     fill
  128.     grestore
  129. } bind def
  130.  
  131. % linewidth width height ellipse --
  132. /tempmatrix matrix def
  133. /ellipse { %def
  134.     tempmatrix currentmatrix pop
  135.     currentpoint roundpoint translate newpath
  136.     scale
  137.     0 0 1 0 360 arc
  138.     tempmatrix setmatrix
  139.     setlinewidth
  140.     stroke
  141. } bind def
  142.  
  143.